home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Video Toaster 4.2
/
Video Toaster v4.2.iso
/
arexx
/
modeler
/
prims.lwm
< prev
next >
Wrap
Text File
|
1993-12-13
|
7KB
|
307 lines
/* Platonic Solid Generator CMD: Platonic Solids
* originally by Tom Wilson, 1992
*
* This program generates the seven platonic solids: tetra, cube,
* octahedron, cubeoctahedron, icosahedron, dodecahedron, and
* icosidodecahedron.
*
* Objects are based on the magic square numbers -- two numbers such that
* x-1 = 1/x. The various coordinates using these two numbers, 0, 1 and 2
* are the corners of all these solids. Each solid is normalized so that
* its vertices lie on the unit sphere before scaling and translation.
*/
sysnam = 'Platonic Solids'
filnam = 'T:solid.state'
version = 'Platonic Solids v1.0'
libadd = addlib("LWModelerARexx.port",0)
MATHLIB="rexxmathlib.library"
IF POS(MATHLIB , SHOW('L')) = 0 THEN
IF ~addlib("rexxmathlib.library",0,-30,0) THEN DO
call notify(1,"!Can't find rexxmathlib.library")
exit
end
solids = 'Tetrahedron Cube Octahedron Cubeoctahedron Icosahedron'
solids = solids 'Dodecahedron Icosidodecahedron'
rad = 1.0
cen = 0 0 0
sel = 1
call req_begin sysnam
id_sel = req_addcontrol("Solid", 'cv', solids)
id_rad = req_addcontrol("Radius", 'n', 1)
id_cen = req_addcontrol("Center", 'v', 1)
call req_setval id_sel, sel
call req_setval id_rad, rad, 1
call req_setval id_cen, cen, 0
if (~req_post()) then do
call req_end
exit
end
sel = req_getval(id_sel)
rad = req_getval(id_rad)
parse value req_getval(id_cen) with cx cy cz .
call req_end
mcl = (sqrt(5)+1)/2
mcs = (sqrt(5)-1)/2
call add_begin
interpret 'call' word(solids,sel)
call add_end
exit
/* The Solids. Each has a kind of custom sub-program to generate it.
*/
Tetrahedron:
scl = rad / sqrt(3)
call point 1.0, 1.0, 1.0
call point 1.0, -1.0, -1.0
call point -1.0, 1.0, -1.0
call point -1.0, -1.0, 1.0
call face 0 1 2
call face 3 1 0
call face 0 2 3
call face 3 2 1
return
Cube:
scl = rad / sqrt(3)
call point 1.0, 1.0, 1.0
call point 1.0, 1.0, -1.0
call point 1.0, -1.0, -1.0
call point 1.0, -1.0, 1.0
call point -1.0, -1.0, 1.0
call point -1.0, 1.0, 1.0
call point -1.0, 1.0, -1.0
call point -1.0, -1.0, -1.0
call face 0 3 2 1
call face 0 5 4 3
call face 0 1 6 5
call face 1 2 7 6
call face 2 3 4 7
call face 4 5 6 7
return
Octahedron:
scl = rad
call point 1.0, 0.0, 0.0
call point -1.0, 0.0, 0.0
call point 0.0, 1.0, 0.0
call point 0.0, -1.0, 0.0
call point 0.0, 0.0, 1.0
call point 0.0, 0.0, -1.0
call face 0 2 4
call face 0 5 2
call face 0 4 3
call face 0 3 5
call face 1 4 2
call face 1 2 5
call face 1 3 4
call face 1 5 3
return
Cubeoctahedron:
scl = rad / sqrt(2)
call point 0.0, 1.0, 1.0
call point 0.0, -1.0, 1.0
call point 0.0, -1.0, -1.0
call point 0.0, 1.0, -1.0
call point 1.0, 0.0, 1.0
call point -1.0, 0.0, 1.0
call point -1.0, 0.0, -1.0
call point 1.0, 0.0, -1.0
call point 1.0, 1.0, 0.0
call point -1.0, 1.0, 0.0
call point -1.0, -1.0, 0.0
call point 1.0, -1.0, 0.0
call face 0 4 8
call face 0 9 5
call face 1 11 4
call face 1 5 10
call face 2 10 6
call face 2 7 11
call face 3 6 9
call face 3 8 7
call face 0 8 3 9
call face 0 5 1 4
call face 1 10 2 11
call face 2 6 3 7
call face 4 11 7 8
call face 5 9 6 10
return
Icosahedron:
scl = rad / sqrt(mcl*mcl + 1)
call point 0.0, mcl, 1.0
call point 0.0, -mcl, 1.0
call point 0.0, mcl, -1.0
call point 0.0, -mcl, -1.0
call point 1.0, 0.0, mcl
call point -1.0, 0.0, mcl
call point 1.0, 0.0, -mcl
call point -1.0, 0.0, -mcl
call point mcl, 1.0, 0.0
call point -mcl, 1.0, 0.0
call point mcl, -1.0, 0.0
call point -mcl, -1.0, 0.0
call face 0 5 4
call face 0 4 8
call face 4 10 8
call face 1 10 4
call face 1 4 5
call face 1 5 11
call face 5 9 11
call face 0 9 5
call face 0 2 9
call face 0 8 2
call face 1 11 3
call face 1 3 10
call face 2 6 7
call face 2 8 6
call face 6 8 10
call face 3 6 10
call face 3 7 6
call face 3 11 7
call face 7 11 9
call face 2 7 9
return
Dodecahedron:
scl = rad / sqrt(3)
call point 0.0, mcs, mcl
call point 0.0, -mcs, mcl
call point 0.0, -mcs, -mcl
call point 0.0, mcs, -mcl
call point mcl, 0.0, mcs
call point -mcl, 0.0, mcs
call point -mcl, 0.0, -mcs
call point mcl, 0.0, -mcs
call point mcs, mcl, 0.0
call point -mcs, mcl, 0.0
call point -mcs, -mcl, 0.0
call point mcs, -mcl, 0.0
call point 1.0, 1.0, 1.0
call point -1.0, 1.0, 1.0
call point -1.0, -1.0, 1.0
call point 1.0, -1.0, 1.0
call point 1.0, -1.0, -1.0
call point 1.0, 1.0, -1.0
call point -1.0, 1.0, -1.0
call point -1.0, -1.0, -1.0
call face 0 1 15 4 12
call face 0 12 8 9 13
call face 0 13 5 14 1
call face 1 14 10 11 15
call face 2 3 17 7 16
call face 2 16 11 10 19
call face 2 19 6 18 3
call face 3 18 9 8 17
call face 4 15 11 16 7
call face 4 7 17 8 12
call face 5 13 9 18 6
call face 5 6 19 10 14
return
Icosidodecahedron:
scl = rad / 2.0
call point 2.0, 0.0, 0.0
call point -2.0, 0.0, 0.0
call point 0.0, 2.0, 0.0
call point 0.0, -2.0, 0.0
call point 0.0, 0.0, 2.0
call point 0.0, 0.0, -2.0
call point mcl, mcs, 1.0
call point mcl, mcs, -1.0
call point mcl, -mcs, 1.0
call point mcl, -mcs, -1.0
call point -mcl, mcs, 1.0
call point -mcl, mcs, -1.0
call point -mcl, -mcs, 1.0
call point -mcl, -mcs, -1.0
call point 1.0, mcl, mcs
call point 1.0, mcl, -mcs
call point 1.0, -mcl, mcs
call point 1.0, -mcl, -mcs
call point -1.0, mcl, mcs
call point -1.0, mcl, -mcs
call point -1.0, -mcl, mcs
call point -1.0, -mcl, -mcs
call point mcs, 1.0, mcl
call point mcs, 1.0, -mcl
call point mcs, -1.0, mcl
call point mcs, -1.0, -mcl
call point -mcs, 1.0, mcl
call point -mcs, 1.0, -mcl
call point -mcs, -1.0, mcl
call point -mcs, -1.0, -mcl
call face 0 7 15 14 6
call face 0 8 16 17 9
call face 1 10 18 19 11
call face 1 13 21 20 12
call face 2 18 26 22 14
call face 2 15 23 27 19
call face 3 16 24 28 20
call face 3 21 29 25 17
call face 4 24 8 6 22
call face 4 26 10 12 28
call face 5 23 7 9 25
call face 5 29 13 11 27
call face 0 6 8
call face 0 9 7
call face 1 12 10
call face 1 11 13
call face 2 14 15
call face 2 19 18
call face 3 17 16
call face 3 20 21
call face 4 22 26
call face 4 28 24
call face 5 27 23
call face 5 25 29
call face 6 14 22
call face 7 23 15
call face 8 24 16
call face 9 17 25
call face 10 26 18
call face 11 19 27
call face 12 20 28
call face 13 29 21
return
/* Generate a point, scaling and translating as we go.
*/
Point:
arg x,y,z
call add_point x*scl+cx y*scl+cy z*scl+cz
return
/* Generate a face, converting from the zero-based C indexing to the
* 1-based arexx index.
*/
Face:
arg plist
n = words(plist)
outl = ''
do i = 1 to n
outl = outl word(plist,i)+1
end i
call add_quad outl
return